{-# OPTIONS_GHC
    -XFunctionalDependencies
    -XMultiParamTypeClasses
    -XOverlappingInstances
    -XFlexibleInstances
    -XFlexibleContexts          #-}
{-
    Proof of Concept Relational System
        todo: change underlying structure for optimization

    relations  are represented as lists of tuples.
    attributes are represented as types.
    vaules and attributes have order as opposed to true RDB.
    all operators are polymorphic and return relations so are composable.

    π rel ::[Integer]   "select Integer from rel"

    rel ≍ "this"        "select * from rel where String = 'this'"


    putStrLn (take 1 (π (rel ≍ fromGregorian 2005 10 24)))
        this prints "select String from rel where Date='2005-10-24' limit 1"
        note: relations are lazy, projections are inferrable.
-}
module Relational where

class Homomorphism a b where
    χ :: a -> b             -- a 'as' b

class Projection r2 r1 where
    π :: r2 -> r1             -- a 'take' b

class Join r1 r2 r3 | r1 r2 -> r3 where
    (⋈) :: r1 -> r2 -> r3      -- a 'natural join' b

class Selection r p where
    (∋) :: r -> p -> r

instance Selection [(a,b)] (a -> Bool) where
    r ∋ p = filter (\(a,_) -> p a) r
instance Selection [(a,b)] (b -> Bool) where
    r ∋ p = filter (\(_,b) -> p b) r
instance Selection [(a,b,c)] (a -> Bool) where
    r ∋ p = filter (\(a,_,_) -> p a) r
instance Selection [(a,b,c)] (b -> Bool) where
    r ∋ p = filter (\(_,b,_) -> p b) r
instance Selection [(a,b,c)] (c -> Bool) where
    r ∋ p = filter (\(_,_,c) -> p c) r
instance Selection [(a,b,c)] ((a,b) -> Bool) where
    r ∋ p = filter (\(a,b,_) -> p (a,b)) r
instance Selection [(a,b,c)] ((a,c) -> Bool) where
    r ∋ p = filter (\(a,_,c) -> p (a,c)) r
instance Selection [(a,b,c)] ((b,c) -> Bool) where
    r ∋ p = filter (\(_,b,c) -> p (b,c)) r
instance Selection [(a,b,c)] ((b,a) -> Bool) where
    r ∋ p = filter (\(a,b,_) -> p (b,a)) r
instance Selection [(a,b,c)] ((c,a) -> Bool) where
    r ∋ p = filter (\(a,_,c) -> p (c,a)) r
instance Selection [(a,b,c)] ((c,b) -> Bool) where
    r ∋ p = filter (\(_,b,c) -> p (c,b)) r
instance Selection [(a,b,c)] ((b,a,c) -> Bool) where
    r ∋ p = filter (\(a,b,c) -> p (b,a,c)) r
instance Selection [(a,b,c)] ((a,c,b) -> Bool) where
    r ∋ p = filter (\(a,b,c) -> p (a,c,b)) r
instance Selection [(a,b,c)] ((c,a,b) -> Bool) where
    r ∋ p = filter (\(a,b,c) -> p (c,a,b)) r
instance Selection [(a,b,c)] ((c,b,a) -> Bool) where
    r ∋ p = filter (\(a,b,c) -> p (c,b,a)) r
    
instance (Eq a) => Join [(a,b)] [(c,a)] [(a,b,c)] where
    r1 ⋈ r2 = [ (a1,b,c) | (a1,b)<-r1, (c,a2)<-r2, a1==a2 ]
instance (Eq a) => Join [(a,b)] [(a,c)] [(a,b,c)] where
    r1 ⋈ r2 = [ (a1,b,c) | (a1,b)<-r1, (a2,c)<-r2, a1==a2 ]
instance (Eq a) => Join [(a,b,c)] [(a,d)] [(a,b,c,d)] where
    r1 ⋈ r2 = [ (a1,b,c,d) | (a1,b,c)<-r1, (a2,d)<-r2, a1==a2 ]
instance (Eq a) => Join [(a,b,c)] [(d,a)] [(a,b,c,d)] where
    r1 ⋈ r2 = [ (a1,b,c,d) | (a1,b,c)<-r1, (d,a2)<-r2, a1==a2 ]
instance (Eq a) => Join  [(a,d)] [(a,b,c)] [(a,b,c,d)] where
    r2 ⋈ r1 = [ (a1,b,c,d) | (a1,b,c)<-r1, (a2,d)<-r2, a1==a2 ]
instance (Eq a) => Join  [(d,a)] [(a,b,c)] [(a,b,c,d)] where
    r2 ⋈ r1 = [ (a1,b,c,d) | (a1,b,c)<-r1, (d,a2)<-r2, a1==a2 ]
          
instance Homomorphism a a where χ = id

instance (Homomorphism a b) => Homomorphism [a] [b] where
    χ r = map χ r
instance (Homomorphism a c, Homomorphism b d)
    => Homomorphism [(a,b)] [(c,d)] where
        χ r = map (\(a,b)->(χ a, χ b)) r
instance Homomorphism [(a,b)] [(b,a)] where
        χ r = map (\(a,b)->(b,a)) r
instance (Homomorphism a d, Homomorphism b e, Homomorphism c f)
    => Homomorphism [(a,b,c)] [(d,e,f)] where
        χ r = map (\(a,b,c)->(χ a, χ b, χ c)) r
instance Homomorphism [(a,b,c)] [(a,c,b)] where
        χ r = map (\(a,b,c)->(a,c,b)) r
instance Homomorphism [(a,b,c)] [(c,a,b)] where
        χ r = map (\(a,b,c)->(c,a,b)) r
instance Homomorphism [(a,b,c)] [(b,a,c)] where
        χ r = map (\(a,b,c)->(b,a,c)) r
instance Homomorphism [(a,b,c)] [(c,b,a)] where
        χ r = map (\(a,b,c)->(c,b,a)) r
instance (Homomorphism a e, Homomorphism b f, Homomorphism c g, Homomorphism d h)
    => Homomorphism [(a,b,c,d)] [(e,f,g,h)] where
        χ r = map (\(a,b,c,d)->(χ a, χ b, χ c, χ d)) r
        
instance Projection [a] [a] where π r = map (\a->a) r
instance Projection [(a,b)] [a] where π r = map (\(a,_)->a) r
instance Projection [(a,b)] [b] where π r = map (\(_,b)->b) r
instance Projection [(a,b,c)] [a] where π r = map (\(a,_,_)->a) r
instance Projection [(a,b,c)] [b] where π r = map (\(_,b,_)->b) r
instance Projection [(a,b,c)] [c] where π r = map (\(_,_,c)->c) r
instance Projection [(a,b,c)] [(a,b)] where π r = map (\(a,b,_)->(a,b)) r
instance Projection [(a,b,c)] [(a,c)] where π r = map (\(a,_,c)->(a,c)) r
instance Projection [(a,b,c)] [(b,c)] where π r = map (\(_,b,c)->(b,c)) r
instance Projection [(a,b,c)] [(b,a)] where π r = map (\(a,b,_)->(b,a)) r
instance Projection [(a,b,c)] [(c,a)] where π r = map (\(a,_,c)->(c,a)) r
instance Projection [(a,b,c)] [(c,b)] where π r = map (\(_,b,c)->(c,b)) r
instance Projection [(a,b,c,d)] [a] where π r = map (\(a,_,_,_)->a) r
instance Projection [(a,b,c,d)] [b] where π r = map (\(_,b,_,_)->b) r
instance Projection [(a,b,c,d)] [c] where π r = map (\(_,_,c,_)->c) r
instance Projection [(a,b,c,d)] [d] where π r = map (\(_,_,_,d)->d) r

